Creating Patient Symptom Table

Overview

Details on the construction of the MedStar EPCR Patient symptom table. 126 unique symptoms were recorded for 2853 calls. A total of 4086 symptoms were recorded among the calls.

Load packages and data

library(tidyverse)
library(bfuncs)

symptoms <- feather::read_feather("/Users/jaredwiegand/Desktop/DETECT Repository/symptoms.feather")

• Adding file path for DETECT data server.
  
• Brad emailed Chris Harvey on 2019-02-11 to make Jared an authorized user.

symptoms <- feather::read_feather("/Volumes/DETECT/one_year_data/symptoms.feather")

about_data(symptoms) # 28,228 observations and 2 variables

[1] "28,228 observations and 2 variables"

top

Simplify symptom list

Currently, the symptom list includes upper and lower case letters, spaces, and special characters. These are not characteristics we want on our variable names, and they make matching with regular expressions more difficult. We want to do both of those things below. So, here we will:

• Convert all letters to lower case
  
• Replace spaces with underscores
  
• Replace parentheses with underscores
  
• Replace periods with underscores
  
• Replace commas with underscores
  
• Replace all instances of 2 or more consecutive underscores we created in the process with single underscores
  
• Remove trailing underscores

simplify_symptom_strings <- function(x) {
  x %>% 
    tolower() %>% 
    stringr::str_replace_all(pattern = "\\s", replacement = "_") %>% # white space
    stringr::str_replace_all(pattern = "[\\(|\\)]", replacement = "_") %>% # parentheses
    stringr::str_replace_all(pattern = "\\.", replacement = "_") %>% # periods
    stringr::str_replace_all(pattern = "\\,(?=\\_)", replacement = "_") %>% # commas - not separating symptoms
    stringr::str_replace_all(pattern = "\\_{2,}", replacement = "_") %>% # multiple underscores
    stringr::str_replace_all(pattern = "\\_(?=\\')", replacement = "") # trailing underscores
}

symptoms <- symptoms %>% 
  mutate(symptoms_simplified = simplify_symptom_strings(symptoms))

about_data(symptoms) # 28,228 observations and 3 variables

[1] "28,228 observations and 3 variables"

top

Find all symptoms

• Figure out how to break character stings into component symptoms
  
• Get list of all unique symptoms
  
• Turn symptoms into binary variables
  
• Create new table of symptoms
  
• Create two-way table of symptoms by incident complaint

Create List of Unique Symptoms

symptom_list <- symptoms %>% 
  filter(!is.na(symptoms_simplified)) %>% # Remove NA
  pull(symptoms_simplified) %>% # Coerce to vector 
  unique() %>% # Gets unique groups of symptoms
  stringr::str_split(pattern = "'',''") %>% # Splits character string at '',''
  unlist() %>% # Coerce from list to vector
  stringr::str_remove_all("'") %>% # Remove remaining single quotes
  unique() # Get unique symptoms

Create dummy variables for each symptom, by the same name

for (i in seq_along(symptom_list)) {
  symptoms[symptom_list[i]] <- NA
}
rm(i)

about_data(symptoms) # 28,228 observations and 129 variables

[1] "28,228 observations and 129 variables"

Assign values for each symptom dummy variable

for (i in seq_along(symptom_list)) {
  # For each variable in symptoms that shares the name of the i'th value in symptom_list
  symptoms[symptom_list[i]] <- if_else( 
    # If the name of the variable is found anywhere in symptoms_simplified
    # Set the value of that variable to 1 in that row
    # Otherwise set it to 0
    stringr::str_detect(
      string = symptoms$symptoms_simplified, 
      pattern = symptom_list[i]
    ), 1, 0
  )
}
rm(i)

about_data(symptoms) # 28,228 observations and 129 variables

[1] "28,228 observations and 129 variables"

top

Frequency Tables

Incident complaints

In descending order of occurrence

Incident symptoms

In descending order of occurrence

Cross Tabulation of Incident Complaint by Symptoms

This table is so large that it is difficult to digest. Let’s make a heat map

top

Heat maps

Reorient the table above so that each row is a combination of incident complaint and symptom

complaint_symptoms_cross_gathered <- complaint_symptoms_cross %>% 
  
  # Gather symptom columns for heatmap
  group_by(incident_complaint) %>% 
  gather(key = symptom, value = n, -incident_complaint) %>% 
  
  # Make the symptoms shorter/easier to read by removing everything
  # including and after "_r53_1, _k59_00, etc."
  mutate(symptom_short = stringr::str_replace_all(
    string = symptom,
    pattern = "_[a-z]\\d+\\S*",
    replacement = ''
  )) %>% 
  
  # Improve readability
  arrange(incident_complaint, desc(n)) %>% 
  select(incident_complaint, symptom_short, n) %>%  
  print()

Some incident complaints, no symptoms are ever recorded. They are:

 [1] "Animal Bite"                                                              
 [2] "Auto vs. Pedestrian"                                                      
 [3] "Cardiac Arrest - Possible DOA"                                            
 [4] "Drowning/Diving/SCUBA Accident"                                           
 [5] "Eye Problem/Injury"                                                       
 [6] "Industrial Accident/Inaccessible Incident/Other Entrapments (Non-Vehicle)"
 [7] "Invalid Assist/Lifting Assist"                                            
 [8] "Medical Alarm"                                                            
 [9] "Nausea/Vomiting"                                                          
[10] "Pain"                                                                     
[11] "Unresponsive"                                                             

We will drop these incident complaints from the data becasue they will add no information to the heatmaps below.

complaint_symptoms_cross_gathered <- complaint_symptoms_cross_gathered %>% 
  mutate(cum_n = max(cumsum(n))) %>% 
  filter(cum_n > 0)

Absolute occurrence

Here we are plotting the number of times that given compliant/symptom pair occurred in the data.

complaint_symptoms_heatmap <- complaint_symptoms_cross_gathered %>% 
  ggplot() +
    geom_tile(aes(incident_complaint, symptom_short, fill = n)) + 
    theme(
      axis.text.y = element_text(size = 9),
      axis.text.x = element_text(size = 10, hjust = 1, vjust = 0.5, angle = 90)
    )

Hard to read in this limited space.
* Save as image file.
* Add image to the html page

ggsave(
  filename = "fig_complain_symptom_heatmap.png",
  plot = complaint_symptoms_heatmap,
  device = "png",
  path = "../images",
  width = 15,
  height = 20,
  units = "in"
)

Relative observation of symptoms

For each incident complaint, what was the proportion of times a given symptom was recorded when any symptoms were recorded?

relative_symptoms_heatmap <- complaint_symptoms_cross_gathered %>% 
  # Calculate propotions
  mutate(
    prop = n / max(cumsum(n))
  ) %>% 
  
  # Plot heatmap
  ggplot() +
    geom_tile(aes(incident_complaint, symptom_short, fill = prop)) +
    theme(
      axis.text.y = element_text(size = 9),
      axis.text.x = element_text(size = 10, hjust = 1, vjust = 0.5, angle = 90)
    )

Hard to read in this limited space.
* Save as image file.
* Add image to the html page

ggsave(
  filename = "fig_relative_symptoms_heatmap.png",
  plot = relative_symptoms_heatmap,
  device = "png",
  path = "../images",
  width = 15,
  height = 20,
  units = "in"
)

top

Session information

R version 3.5.1 (2018-07-02)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS  10.14.3

Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] bindrcpp_0.2.2  bfuncs_0.2.1    forcats_0.3.0   stringr_1.3.1   dplyr_0.7.8     purrr_0.2.5    
 [7] readr_1.2.1     tidyr_0.8.2     tibble_1.4.2    ggplot2_3.1.0   tidyverse_1.2.1 packrat_0.4.9-3

loaded via a namespace (and not attached):
 [1] tidyselect_0.2.5 haven_2.0.0      lattice_0.20-35  colorspace_1.3-2 generics_0.0.2   htmltools_0.3.6 
 [7] yaml_2.2.0       base64enc_0.1-3  utf8_1.1.4       rlang_0.3.0.1    later_0.7.5      pillar_1.3.0    
[13] glue_1.3.0       withr_2.1.2      modelr_0.1.2     readxl_1.1.0     bindr_0.1.1      plyr_1.8.4      
[19] munsell_0.5.0    gtable_0.2.0     cellranger_1.1.0 rvest_0.3.2      htmlwidgets_1.3  evaluate_0.12   
[25] labeling_0.3     knitr_1.20       httpuv_1.4.5     crosstalk_1.0.0  fansi_0.4.0      broom_0.5.1     
[31] Rcpp_1.0.0       xtable_1.8-3     promises_1.0.1   DT_0.5           scales_1.0.0     backports_1.1.2 
[37] feather_0.3.1    jsonlite_1.5     mime_0.6         hms_0.4.2        digest_0.6.18    stringi_1.2.4   
[43] shiny_1.2.0      grid_3.5.1       rprojroot_1.3-2  cli_1.0.1        tools_3.5.1      magrittr_1.5    
[49] lazyeval_0.2.1   crayon_1.3.4     pkgconfig_2.0.2  xml2_1.2.0       lubridate_1.7.4  assertthat_0.2.0
[55] rmarkdown_1.10   httr_1.3.1       rstudioapi_0.8   R6_2.3.0         nlme_3.1-137     compiler_3.5.1